home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / str.c < prev    next >
Text File  |  1993-10-23  |  35KB  |  1,624 lines
  1. /* $RCSfile: str.c,v $$Revision: 4.0.1.7 $$Date: 1993/02/05 19:43:47 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the Perl Artistic License,
  6.  *    as specified in the README file.
  7.  *
  8.  * $Log:    str.c,v $
  9.  * Revision 4.0.1.6  1992/06/11  21:14:21  lwall
  10.  * patch34: quotes containing subscripts containing variables didn't parse right
  11.  * 
  12.  * Revision 4.0.1.5  92/06/08  15:40:43  lwall
  13.  * patch20: removed implicit int declarations on functions
  14.  * patch20: Perl now distinguishes overlapped copies from non-overlapped
  15.  * patch20: paragraph mode now skips extra newlines automatically
  16.  * patch20: fixed memory leak in doube-quote interpretation
  17.  * patch20: made /\$$foo/ look for literal '$foo'
  18.  * patch20: "$var{$foo'bar}" didn't scan subscript correctly
  19.  * patch20: a splice on non-existent array elements could dump core
  20.  * patch20: running taintperl explicitly now does checks even if $< == $>
  21.  * 
  22.  * Revision 4.0.1.4  91/11/05  18:40:51  lwall
  23.  * patch11: $foo .= <BAR> could overrun malloced memory
  24.  * patch11: \$ didn't always make it through double-quoter to regexp routines
  25.  * patch11: prepared for ctype implementations that don't define isascii()
  26.  * 
  27.  * Revision 4.0.1.3  91/06/10  01:27:54  lwall
  28.  * patch10: $) and $| incorrectly handled in run-time patterns
  29.  * 
  30.  * Revision 4.0.1.2  91/06/07  11:58:13  lwall
  31.  * patch4: new copyright notice
  32.  * patch4: taint check on undefined string could cause core dump
  33.  * 
  34.  * Revision 4.0.1.1  91/04/12  09:15:30  lwall
  35.  * patch1: fixed undefined environ problem
  36.  * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
  37.  * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo
  38.  * 
  39.  * Revision 4.0  91/03/20  01:39:55  lwall
  40.  * 4.0 baseline.
  41.  * 
  42.  */
  43.  
  44. #include "EXTERN.h"
  45. #include "perl.h"
  46. #include "perly.h"
  47.  
  48. static void ucase();
  49. static void lcase();
  50.  
  51. #ifndef str_get
  52. char *
  53. str_get(str)
  54. STR *str;
  55. {
  56. #ifdef TAINT
  57.     tainted |= str->str_tainted;
  58. #endif
  59.     return str->str_pok ? str->str_ptr : str_2ptr(str);
  60. }
  61. #endif
  62.  
  63. /* dlb ... guess we have a "crippled cc".
  64.  * dlb the following functions are usually macros.
  65.  */
  66. #ifndef str_true
  67. int
  68. str_true(Str)
  69. STR *Str;
  70. {
  71.     if (Str->str_pok) {
  72.         if (*Str->str_ptr > '0' ||
  73.           Str->str_cur > 1 ||
  74.           (Str->str_cur && *Str->str_ptr != '0'))
  75.         return 1;
  76.         return 0;
  77.     }
  78.     if (Str->str_nok)
  79.         return (Str->str_u.str_nval != 0.0);
  80.     return 0;
  81. }
  82. #endif /* str_true */
  83.  
  84. #ifndef str_gnum
  85. double str_gnum(Str)
  86. STR *Str;
  87. {
  88. #ifdef TAINT
  89.     tainted |= Str->str_tainted;
  90. #endif /* TAINT*/
  91.     if (Str->str_nok)
  92.         return Str->str_u.str_nval;
  93.     return str_2num(Str);
  94. }
  95. #endif /* str_gnum */
  96. /* dlb ... end of crutch */
  97.  
  98. char *
  99. str_grow(str,newlen)
  100. register STR *str;
  101. #ifndef DOSISH
  102. register int newlen;
  103. #else
  104. unsigned long newlen;
  105. #endif
  106. {
  107.     register char *s = str->str_ptr;
  108.  
  109. #ifdef MSDOS
  110.     if (newlen >= 0x10000) {
  111.     fprintf(stderr, "Allocation too large: %lx\n", newlen);
  112.     exit(1);
  113.     }
  114. #endif /* MSDOS */
  115.     if (str->str_state == SS_INCR) {        /* data before str_ptr? */
  116.     str->str_len += str->str_u.str_useful;
  117.     str->str_ptr -= str->str_u.str_useful;
  118.     str->str_u.str_useful = 0L;
  119.     Move(s, str->str_ptr, str->str_cur+1, char);
  120.     s = str->str_ptr;
  121.     str->str_state = SS_NORM;            /* normal again */
  122.     if (newlen > str->str_len)
  123.         newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
  124.     }
  125.     if (newlen > str->str_len) {        /* need more room? */
  126.         if (str->str_len)
  127.         Renew(s,newlen,char);
  128.         else
  129.         New(703,s,newlen,char);
  130.     str->str_ptr = s;
  131.         str->str_len = newlen;
  132.     }
  133.     return s;
  134. }
  135.  
  136. void
  137. str_numset(str,num)
  138. register STR *str;
  139. double num;
  140. {
  141.     if (str->str_pok) {
  142.     str->str_pok = 0;    /* invalidate pointer */
  143.     if (str->str_state == SS_INCR)
  144.         Str_Grow(str,0);
  145.     }
  146.     str->str_u.str_nval = num;
  147.     str->str_state = SS_NORM;
  148.     str->str_nok = 1;            /* validate number */
  149. #ifdef TAINT
  150.     str->str_tainted = tainted;
  151. #endif
  152. }
  153.  
  154. char *
  155. str_2ptr(str)
  156. register STR *str;
  157. {
  158.     register char *s;
  159.     int olderrno;
  160.  
  161.     if (!str)
  162.     return "";
  163.     if (str->str_nok) {
  164.     STR_GROW(str, 30);
  165.     s = str->str_ptr;
  166.     olderrno = errno;    /* some Xenix systems wipe out errno here */
  167. #if defined(scs) && defined(ns32000)
  168.     gcvt(str->str_u.str_nval,20,s);
  169. #else
  170. #ifdef apollo
  171.     if (str->str_u.str_nval == 0.0)
  172.         (void)strcpy(s,"0");
  173.     else
  174. #endif /*apollo*/
  175.     (void)sprintf(s,"%.20g",str->str_u.str_nval);
  176. #endif /*scs*/
  177.     errno = olderrno;
  178.     while (*s) s++;
  179. #ifdef hcx
  180.     if (s[-1] == '.')
  181.         s--;
  182. #endif
  183.     }
  184.     else {
  185.     if (str == &str_undef)
  186.         return No;
  187.     if (dowarn)
  188.         warn("Use of uninitialized variable");
  189.     STR_GROW(str, 30);
  190.     s = str->str_ptr;
  191.     }
  192.     *s = '\0';
  193.     str->str_cur = s - str->str_ptr;
  194.     str->str_pok = 1;
  195. #ifdef DEBUGGING
  196. #ifdef macintosh
  197.     if (debug & 32)
  198.     fprintf(perldbg,"0x%lx ptr(%s)\n",str,str->str_ptr);
  199. #else
  200.     if (debug & 32)
  201.     fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
  202. #endif
  203. #endif
  204.     return str->str_ptr;
  205. }
  206.  
  207. double
  208. str_2num(str)
  209. register STR *str;
  210. {
  211.     if (!str)
  212.     return 0.0;
  213.     if (str->str_state == SS_INCR)
  214.     Str_Grow(str,0);       /* just force copy down */
  215.     str->str_state = SS_NORM;
  216.     if (str->str_len && str->str_pok)
  217.     str->str_u.str_nval = atof(str->str_ptr);
  218.     else  {
  219.     if (str == &str_undef)
  220.         return 0.0;
  221.     if (dowarn)
  222.         warn("Use of uninitialized variable");
  223.     str->str_u.str_nval = 0.0;
  224.     }
  225.     str->str_nok = 1;
  226. #ifdef DEBUGGING
  227. #ifdef macintosh
  228.     if (debug & 32)
  229.     fprintf(perldbg,"0x%lx num(%g)\n",str,str->str_u.str_nval);
  230. #else
  231.     if (debug & 32)
  232.     fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
  233. #endif
  234. #endif
  235.     return str->str_u.str_nval;
  236. }
  237.  
  238. /* Note: str_sset() should not be called with a source string that needs
  239.  * be reused, since it may destroy the source string if it is marked
  240.  * as temporary.
  241.  */
  242.  
  243. void
  244. str_sset(dstr,sstr)
  245. STR *dstr;
  246. register STR *sstr;
  247. {
  248. #ifdef TAINT
  249.     if (sstr)
  250.     tainted |= sstr->str_tainted;
  251. #endif
  252.     if (sstr == dstr || dstr == &str_undef)
  253.     return;
  254.     if (!sstr)
  255.     dstr->str_pok = dstr->str_nok = 0;
  256.     else if (sstr->str_pok) {
  257.  
  258.     /*
  259.      * Check to see if we can just swipe the string.  If so, it's a
  260.      * possible small lose on short strings, but a big win on long ones.
  261.      * It might even be a win on short strings if dstr->str_ptr
  262.      * has to be allocated and sstr->str_ptr has to be freed.
  263.      */
  264.  
  265.     if (sstr->str_pok & SP_TEMP) {        /* slated for free anyway? */
  266.         if (dstr->str_ptr) {
  267.         if (dstr->str_state == SS_INCR)
  268.             dstr->str_ptr -= dstr->str_u.str_useful;
  269.         Safefree(dstr->str_ptr);
  270.         }
  271.         dstr->str_ptr = sstr->str_ptr;
  272.         dstr->str_len = sstr->str_len;
  273.         dstr->str_cur = sstr->str_cur;
  274.         dstr->str_state = sstr->str_state;
  275.         dstr->str_pok = sstr->str_pok & ~SP_TEMP;
  276. #ifdef TAINT
  277.         dstr->str_tainted = sstr->str_tainted;
  278. #endif
  279.         sstr->str_ptr = Nullch;
  280.         sstr->str_len = 0;
  281.         sstr->str_pok = 0;            /* wipe out any weird flags */
  282.         sstr->str_state = 0;        /* so sstr frees uneventfully */
  283.     }
  284.     else {                    /* have to copy actual string */
  285.         if (dstr->str_ptr) {
  286.         if (dstr->str_state == SS_INCR) {
  287.             Str_Grow(dstr,0);
  288.         }
  289.         }
  290.         str_nset(dstr,sstr->str_ptr,sstr->str_cur);
  291.     }
  292.     /*SUPPRESS 560*/
  293.     if (dstr->str_nok = sstr->str_nok)
  294.         dstr->str_u.str_nval = sstr->str_u.str_nval;
  295.     else {
  296. #ifdef STRUCTCOPY
  297.         dstr->str_u = sstr->str_u;
  298. #else
  299.         dstr->str_u.str_nval = sstr->str_u.str_nval;
  300. #endif
  301.         if (dstr->str_cur == sizeof(STBP)) {
  302.         char *tmps = dstr->str_ptr;
  303.  
  304.         if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
  305.             if (dstr->str_magic && dstr->str_magic->str_rare == 'X') {
  306.             str_free(dstr->str_magic);
  307.             dstr->str_magic = Nullstr;
  308.             }
  309.             if (!dstr->str_magic) {
  310.             dstr->str_magic = str_smake(sstr->str_magic);
  311.             dstr->str_magic->str_rare = 'X';
  312.             }
  313.         }
  314.         }
  315.     }
  316.     }
  317.     else if (sstr->str_nok)
  318.     str_numset(dstr,sstr->str_u.str_nval);
  319.     else {
  320.     if (dstr->str_state == SS_INCR)
  321.         Str_Grow(dstr,0);       /* just force copy down */
  322.  
  323. #ifdef STRUCTCOPY
  324.     dstr->str_u = sstr->str_u;
  325. #else
  326.     dstr->str_u.str_nval = sstr->str_u.str_nval;
  327. #endif
  328.     dstr->str_pok = dstr->str_nok = 0;
  329.     }
  330. }
  331.  
  332. void
  333. str_nset(str,ptr,len)
  334. register STR *str;
  335. register char *ptr;
  336. register STRLEN len;
  337. {
  338.     if (str == &str_undef)
  339.     return;
  340.     STR_GROW(str, len + 1);
  341.     if (ptr)
  342.     Move(ptr,str->str_ptr,len,char);
  343.     str->str_cur = len;
  344.     *(str->str_ptr+str->str_cur) = '\0';
  345.     str->str_nok = 0;        /* invalidate number */
  346.     str->str_pok = 1;        /* validate pointer */
  347. #ifdef TAINT
  348.     str->str_tainted = tainted;
  349. #endif
  350. }
  351.  
  352. void
  353. str_set(str,ptr)
  354. register STR *str;
  355. register char *ptr;
  356. {
  357.     register STRLEN len;
  358.  
  359.     if (str == &str_undef)
  360.     return;
  361.     if (!ptr)
  362.     ptr = "";
  363.     len = strlen(ptr);
  364.     STR_GROW(str, len + 1);
  365.     Move(ptr,str->str_ptr,len+1,char);
  366.     str->str_cur = len;
  367.     str->str_nok = 0;        /* invalidate number */
  368.     str->str_pok = 1;        /* validate pointer */
  369. #ifdef TAINT
  370.     str->str_tainted = tainted;
  371. #endif
  372. }
  373.  
  374. void
  375. str_chop(str,ptr)    /* like set but assuming ptr is in str */
  376. register STR *str;
  377. register char *ptr;
  378. {
  379.     register STRLEN delta;
  380.  
  381.     if (!ptr || !(str->str_pok))
  382.     return;
  383.     delta = ptr - str->str_ptr;
  384.     str->str_len -= delta;
  385.     str->str_cur -= delta;
  386.     str->str_ptr += delta;
  387.     if (str->str_state == SS_INCR)
  388.     str->str_u.str_useful += delta;
  389.     else {
  390.     str->str_u.str_useful = delta;
  391.     str->str_state = SS_INCR;
  392.     }
  393.     str->str_nok = 0;        /* invalidate number */
  394.     str->str_pok = 1;        /* validate pointer (and unstudy str) */
  395. }
  396.  
  397. void
  398. str_ncat(str,ptr,len)
  399. register STR *str;
  400. register char *ptr;
  401. register STRLEN len;
  402. {
  403.     if (str == &str_undef)
  404.     return;
  405.     if (!(str->str_pok))
  406.     (void)str_2ptr(str);
  407.     STR_GROW(str, str->str_cur + len + 1);
  408.     Move(ptr,str->str_ptr+str->str_cur,len,char);
  409.     str->str_cur += len;
  410.     *(str->str_ptr+str->str_cur) = '\0';
  411.     str->str_nok = 0;        /* invalidate number */
  412.     str->str_pok = 1;        /* validate pointer */
  413. #ifdef TAINT
  414.     str->str_tainted |= tainted;
  415. #endif
  416. }
  417.  
  418. void
  419. str_scat(dstr,sstr)
  420. STR *dstr;
  421. register STR *sstr;
  422. {
  423.     if (!sstr)
  424.     return;
  425. #ifdef TAINT
  426.     tainted |= sstr->str_tainted;
  427. #endif
  428.     if (!(sstr->str_pok))
  429.     (void)str_2ptr(sstr);
  430.     if (sstr)
  431.     str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
  432. }
  433.  
  434. void
  435. str_cat(str,ptr)
  436. register STR *str;
  437. register char *ptr;
  438. {
  439.     register STRLEN len;
  440.  
  441.     if (str == &str_undef)
  442.     return;
  443.     if (!ptr)
  444.     return;
  445.     if (!(str->str_pok))
  446.     (void)str_2ptr(str);
  447.     len = strlen(ptr);
  448.     STR_GROW(str, str->str_cur + len + 1);
  449.     Move(ptr,str->str_ptr+str->str_cur,len+1,char);
  450.     str->str_cur += len;
  451.     str->str_nok = 0;        /* invalidate number */
  452.     str->str_pok = 1;        /* validate pointer */
  453. #ifdef TAINT
  454.     str->str_tainted |= tainted;
  455. #endif
  456. }
  457.  
  458. char *
  459. str_append_till(str,from,fromend,delim,keeplist)
  460. register STR *str;
  461. register char *from;
  462. register char *fromend;
  463. register int delim;
  464. char *keeplist;
  465. {
  466.     register char *to;
  467.     register STRLEN len;
  468.  
  469.     if (str == &str_undef)
  470.     return Nullch;
  471.     if (!from)
  472.     return Nullch;
  473.     len = fromend - from;
  474.     STR_GROW(str, str->str_cur + len + 1);
  475.     str->str_nok = 0;        /* invalidate number */
  476.     str->str_pok = 1;        /* validate pointer */
  477.     to = str->str_ptr+str->str_cur;
  478.     for (; from < fromend; from++,to++) {
  479.     if (*from == '\\' && from+1 < fromend && delim != '\\') {
  480.         if (!keeplist) {
  481.         if (from[1] == delim || from[1] == '\\')
  482.             from++;
  483.         else
  484.             *to++ = *from++;
  485.         }
  486.         else if (from[1] && index(keeplist,from[1]))
  487.         *to++ = *from++;
  488.         else
  489.         from++;
  490.     }
  491.     else if (*from == delim)
  492.         break;
  493.     *to = *from;
  494.     }
  495.     *to = '\0';
  496.     str->str_cur = to - str->str_ptr;
  497.     return from;
  498. }
  499.  
  500. STR *
  501. #ifdef LEAKTEST
  502. str_new(x,len)
  503. int x;
  504. #else
  505. str_new(len)
  506. #endif
  507. STRLEN len;
  508. {
  509.     register STR *str;
  510.     
  511.     if (freestrroot) {
  512.     str = freestrroot;
  513.     freestrroot = str->str_magic;
  514.     str->str_magic = Nullstr;
  515.     str->str_state = SS_NORM;
  516.     }
  517.     else {
  518.     Newz(700+x,str,1,STR);
  519.     }
  520.     if (len)
  521.     STR_GROW(str, len + 1);
  522.     return str;
  523. }
  524.  
  525. void
  526. str_magic(str, stab, how, name, namlen)
  527. register STR *str;
  528. STAB *stab;
  529. int how;
  530. char *name;
  531. STRLEN namlen;
  532. {
  533.     if (str == &str_undef || str->str_magic)
  534.     return;
  535.     str->str_magic = Str_new(75,namlen);
  536.     str = str->str_magic;
  537.     str->str_u.str_stab = stab;
  538.     str->str_rare = how;
  539.     if (name)
  540.     str_nset(str,name,namlen);
  541. }
  542.  
  543. void
  544. str_insert(bigstr,offset,len,little,littlelen)
  545. STR *bigstr;
  546. STRLEN offset;
  547. STRLEN len;
  548. char *little;
  549. STRLEN littlelen;
  550. {
  551.     register char *big;
  552.     register char *mid;
  553.     register char *midend;
  554.     register char *bigend;
  555.     register int i;
  556.  
  557.     if (bigstr == &str_undef)
  558.     return;
  559.     bigstr->str_nok = 0;
  560.     bigstr->str_pok = SP_VALID;    /* disable possible screamer */
  561.  
  562.     i = littlelen - len;
  563.     if (i > 0) {            /* string might grow */
  564.     STR_GROW(bigstr, bigstr->str_cur + i + 1);
  565.     big = bigstr->str_ptr;
  566.     mid = big + offset + len;
  567.     midend = bigend = big + bigstr->str_cur;
  568.     bigend += i;
  569.     *bigend = '\0';
  570.     while (midend > mid)        /* shove everything down */
  571.         *--bigend = *--midend;
  572.     Move(little,big+offset,littlelen,char);
  573.     bigstr->str_cur += i;
  574.     STABSET(bigstr);
  575.     return;
  576.     }
  577.     else if (i == 0) {
  578.     Move(little,bigstr->str_ptr+offset,len,char);
  579.     STABSET(bigstr);
  580.     return;
  581.     }
  582.  
  583.     big = bigstr->str_ptr;
  584.     mid = big + offset;
  585.     midend = mid + len;
  586.     bigend = big + bigstr->str_cur;
  587.  
  588.     if (midend > bigend)
  589.     fatal("panic: str_insert");
  590.  
  591.     if (mid - big > bigend - midend) {    /* faster to shorten from end */
  592.     if (littlelen) {
  593.         Move(little, mid, littlelen,char);
  594.         mid += littlelen;
  595.     }
  596.     i = bigend - midend;
  597.     if (i > 0) {
  598.         Move(midend, mid, i,char);
  599.         mid += i;
  600.     }
  601.     *mid = '\0';
  602.     bigstr->str_cur = mid - big;
  603.     }
  604.     /*SUPPRESS 560*/
  605.     else if (i = mid - big) {    /* faster from front */
  606.     midend -= littlelen;
  607.     mid = midend;
  608.     str_chop(bigstr,midend-i);
  609.     big += i;
  610.     while (i--)
  611.         *--midend = *--big;
  612.     if (littlelen)
  613.         Move(little, mid, littlelen,char);
  614.     }
  615.     else if (littlelen) {
  616.     midend -= littlelen;
  617.     str_chop(bigstr,midend);
  618.     Move(little,midend,littlelen,char);
  619.     }
  620.     else {
  621.     str_chop(bigstr,midend);
  622.     }
  623.     STABSET(bigstr);
  624. }
  625.  
  626. /* make str point to what nstr did */
  627.  
  628. void
  629. str_replace(str,nstr)
  630. register STR *str;
  631. register STR *nstr;
  632. {
  633.     if (str == &str_undef)
  634.     return;
  635.     if (str->str_state == SS_INCR)
  636.     Str_Grow(str,0);    /* just force copy down */
  637.     if (nstr->str_state == SS_INCR)
  638.     Str_Grow(nstr,0);
  639.     if (str->str_ptr)
  640.     Safefree(str->str_ptr);
  641.     str->str_ptr = nstr->str_ptr;
  642.     str->str_len = nstr->str_len;
  643.     str->str_cur = nstr->str_cur;
  644.     str->str_pok = nstr->str_pok;
  645.     str->str_nok = nstr->str_nok;
  646. #ifdef STRUCTCOPY
  647.     str->str_u = nstr->str_u;
  648. #else
  649.     str->str_u.str_nval = nstr->str_u.str_nval;
  650. #endif
  651. #ifdef TAINT
  652.     str->str_tainted = nstr->str_tainted;
  653. #endif
  654.     if (nstr->str_magic)
  655.     str_free(nstr->str_magic);
  656.     Safefree(nstr);
  657. }
  658.  
  659. void
  660. str_free(str)
  661. register STR *str;
  662. {
  663.     if (!str || str == &str_undef)
  664.     return;
  665.     if (str->str_state) {
  666.     if (str->str_state == SS_FREE)    /* already freed */
  667.         return;
  668.     if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
  669.         str->str_ptr -= str->str_u.str_useful;
  670.         str->str_len += str->str_u.str_useful;
  671.     }
  672.     }
  673.     if (str->str_magic)
  674.     str_free(str->str_magic);
  675.     str->str_magic = freestrroot;
  676. #ifdef LEAKTEST
  677.     if (str->str_len) {
  678.     Safefree(str->str_ptr);
  679.     str->str_ptr = Nullch;
  680.     }
  681.     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
  682.     arg_free(str->str_u.str_args);
  683.     Safefree(str);
  684. #else /* LEAKTEST */
  685.     if (str->str_len) {
  686.     if (str->str_len > 127) {    /* next user not likely to want more */
  687.         Safefree(str->str_ptr);    /* so give it back to malloc */
  688.         str->str_ptr = Nullch;
  689.         str->str_len = 0;
  690.     }
  691.     else
  692.         str->str_ptr[0] = '\0';
  693.     }
  694.     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
  695.     arg_free(str->str_u.str_args);
  696.     str->str_cur = 0;
  697.     str->str_nok = 0;
  698.     str->str_pok = 0;
  699.     str->str_state = SS_FREE;
  700. #ifdef TAINT
  701.     str->str_tainted = 0;
  702. #endif
  703.     freestrroot = str;
  704. #endif /* LEAKTEST */
  705. }
  706.  
  707. STRLEN
  708. str_len(str)
  709. register STR *str;
  710. {
  711.     if (!str)
  712.     return 0;
  713.     if (!(str->str_pok))
  714.     (void)str_2ptr(str);
  715.     if (str->str_ptr)
  716.     return str->str_cur;
  717.     else
  718.     return 0;
  719. }
  720.  
  721. int
  722. str_eq(str1,str2)
  723. register STR *str1;
  724. register STR *str2;
  725. {
  726.     if (!str1 || str1 == &str_undef)
  727.     return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur);
  728.     if (!str2 || str2 == &str_undef)
  729.     return !str1->str_cur;
  730.  
  731.     if (!str1->str_pok)
  732.     (void)str_2ptr(str1);
  733.     if (!str2->str_pok)
  734.     (void)str_2ptr(str2);
  735.  
  736.     if (str1->str_cur != str2->str_cur)
  737.     return 0;
  738.  
  739.     return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
  740. }
  741.  
  742. int
  743. str_cmp(str1,str2)
  744. register STR *str1;
  745. register STR *str2;
  746. {
  747.     int retval;
  748.  
  749.     if (!str1 || str1 == &str_undef)
  750.     return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1;
  751.     if (!str2 || str2 == &str_undef)
  752.     return str1->str_cur != 0;
  753.  
  754.     if (!str1->str_pok)
  755.     (void)str_2ptr(str1);
  756.     if (!str2->str_pok)
  757.     (void)str_2ptr(str2);
  758.  
  759.     if (str1->str_cur < str2->str_cur) {
  760.     /*SUPPRESS 560*/
  761.     if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
  762.         return retval < 0 ? -1 : 1;
  763.     else
  764.         return -1;
  765.     }
  766.     /*SUPPRESS 560*/
  767.     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
  768.     return retval < 0 ? -1 : 1;
  769.     else if (str1->str_cur == str2->str_cur)
  770.     return 0;
  771.     else
  772.     return 1;
  773. }
  774.  
  775. char *
  776. str_gets(str,fp,append)
  777. register STR *str;
  778. register FILE *fp;
  779. int append;
  780. {
  781.     register char *bp;        /* we're going to steal some values */
  782.     register int cnt;        /*  from the stdio struct and put EVERYTHING */
  783.     register STDCHAR *ptr;    /*   in the innermost loop into registers */
  784.     register int newline = rschar;/* (assuming >= 6 registers) */
  785.     int i;
  786.     STRLEN bpx;
  787.     int shortbuffered;
  788.  
  789.     if (str == &str_undef)
  790.     return Nullch;
  791.     if (rspara) {        /* have to do this both before and after */
  792.     do {            /* to make sure file boundaries work right */
  793.         i = getc(fp);
  794.         if (i != '\n') {
  795.         ungetc(i,fp);
  796.         break;
  797.         }
  798.     } while (i != EOF);
  799.     }
  800. #ifdef STDSTDIO        /* Here is some breathtakingly efficient cheating */
  801.     cnt = fp->_cnt;            /* get count into register */
  802.     str->str_nok = 0;            /* invalidate number */
  803.     str->str_pok = 1;            /* validate pointer */
  804.     if (str->str_len - append <= cnt + 1) { /* make sure we have the room */
  805.     if (cnt > 80 && str->str_len > append) {
  806.         shortbuffered = cnt - str->str_len + append + 1;
  807.         cnt -= shortbuffered;
  808.     }
  809.     else {
  810.         shortbuffered = 0;
  811.         STR_GROW(str, append+cnt+2);/* (remembering cnt can be -1) */
  812.     }
  813.     }
  814.     else
  815.     shortbuffered = 0;
  816.     bp = str->str_ptr + append;        /* move these two too to registers */
  817.     ptr = fp->_ptr;
  818.     for (;;) {
  819.       screamer:
  820.     while (--cnt >= 0) {            /* this */    /* eat */
  821.         if ((*bp++ = *ptr++) == newline)    /* really */    /* dust */
  822.         goto thats_all_folks;        /* screams */    /* sed :-) */ 
  823.     }
  824.     
  825.     if (shortbuffered) {            /* oh well, must extend */
  826.         cnt = shortbuffered;
  827.         shortbuffered = 0;
  828.         bpx = bp - str->str_ptr;    /* prepare for possible relocation */
  829.         str->str_cur = bpx;
  830.         STR_GROW(str, str->str_len + append + cnt + 2);
  831.         bp = str->str_ptr + bpx;    /* reconstitute our pointer */
  832.         continue;
  833.     }
  834.  
  835.     fp->_cnt = cnt;            /* deregisterize cnt and ptr */
  836.     fp->_ptr = ptr;
  837.     i = _filbuf(fp);        /* get more characters */
  838.     cnt = fp->_cnt;
  839.     ptr = fp->_ptr;            /* reregisterize cnt and ptr */
  840.  
  841.     bpx = bp - str->str_ptr;    /* prepare for possible relocation */
  842.     str->str_cur = bpx;
  843.     STR_GROW(str, bpx + cnt + 2);
  844.     bp = str->str_ptr + bpx;    /* reconstitute our pointer */
  845.  
  846.     if (i == newline) {        /* all done for now? */
  847.         *bp++ = i;
  848.         goto thats_all_folks;
  849.     }
  850.     else if (i == EOF)        /* all done for ever? */
  851.         goto thats_really_all_folks;
  852.     *bp++ = i;            /* now go back to screaming loop */
  853.     }
  854.  
  855. thats_all_folks:
  856.     if (rslen > 1 && (bp - str->str_ptr < rslen || bcmp(bp - rslen, rs, rslen)))
  857.     goto screamer;    /* go back to the fray */
  858. thats_really_all_folks:
  859.     if (shortbuffered)
  860.     cnt += shortbuffered;
  861.     fp->_cnt = cnt;            /* put these back or we're in trouble */
  862.     fp->_ptr = ptr;
  863.     *bp = '\0';
  864.     str->str_cur = bp - str->str_ptr;    /* set length */
  865.  
  866. #else /* !STDSTDIO */    /* The big, slow, and stupid way */
  867.  
  868.     {
  869.     static char buf[8192];
  870.     char * bpe = buf + sizeof(buf) - 3;
  871.  
  872. screamer:
  873.     bp = buf;
  874.     while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
  875.  
  876.     if (append)
  877.         str_ncat(str, buf, bp - buf);
  878.     else
  879.         str_nset(str, buf, bp - buf);
  880.     if (i != EOF            /* joy */
  881.         &&
  882.         (i != newline
  883.          ||
  884.          (rslen > 1
  885.           &&
  886.           (str->str_cur < rslen
  887.            ||
  888.            bcmp(str->str_ptr + str->str_cur - rslen, rs, rslen)
  889.           )
  890.          )
  891.         )
  892.        )
  893.     {
  894.         append = -1;
  895.         goto screamer;
  896.     }
  897.     }
  898.  
  899. #endif /* STDSTDIO */
  900.  
  901.     if (rspara) {
  902.         while (i != EOF) {
  903.         i = getc(fp);
  904.         if (i != '\n') {
  905.         ungetc(i,fp);
  906.         break;
  907.         }
  908.     }
  909.     }
  910.     return str->str_cur - append ? str->str_ptr : Nullch;
  911. }
  912.  
  913. ARG *
  914. parselist(str)
  915. STR *str;
  916. {
  917.     register CMD *cmd;
  918.     register ARG *arg;
  919.     CMD *oldcurcmd = curcmd;
  920.     int oldperldb = perldb;
  921.     int retval;
  922.  
  923.     perldb = 0;
  924.     str_sset(linestr,str);
  925.     in_eval++;
  926.     oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
  927.     bufend = bufptr + linestr->str_cur;
  928.     if (++loop_ptr >= loop_max) {
  929.         loop_max += 128;
  930.         Renew(loop_stack, loop_max, struct loop);
  931.     }
  932.     loop_stack[loop_ptr].loop_label = "_EVAL_";
  933.     loop_stack[loop_ptr].loop_sp = 0;
  934. #ifdef DEBUGGING
  935.     if (debug & 4) {
  936.         deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
  937.     }
  938. #endif
  939.     if (setjmp(loop_stack[loop_ptr].loop_env)) {
  940.     in_eval--;
  941.     loop_ptr--;
  942.     perldb = oldperldb;
  943.     fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
  944.     }
  945. #ifdef DEBUGGING
  946.     if (debug & 4) {
  947.     char *tmps = loop_stack[loop_ptr].loop_label;
  948.     deb("(Popping label #%d %s)\n",loop_ptr,
  949.         tmps ? tmps : "" );
  950.     }
  951. #endif
  952.     loop_ptr--;
  953.     error_count = 0;
  954.     curcmd = &compiling;
  955.     curcmd->c_line = oldcurcmd->c_line;
  956.     retval = yyparse();
  957.     curcmd = oldcurcmd;
  958.     perldb = oldperldb;
  959.     in_eval--;
  960.     if (retval || error_count)
  961.     fatal("Invalid component in string or format");
  962.     cmd = eval_root;
  963.     arg = cmd->c_expr;
  964.     if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
  965.     fatal("panic: error in parselist %d %x %d", cmd->c_type,
  966.       cmd->c_next, arg ? arg->arg_type : -1);
  967.     cmd->c_expr = Nullarg;
  968.     cmd_free(cmd);
  969.     eval_root = Nullcmd;
  970.     return arg;
  971. }
  972.  
  973. void
  974. intrpcompile(src)
  975. STR *src;
  976. {
  977.     register char *s = str_get(src);
  978.     register char *send = s + src->str_cur;
  979.     register STR *str;
  980.     register char *t;
  981.     STR *toparse;
  982.     STRLEN len;
  983.     register int brackets;
  984.     register char *d;
  985.     STAB *stab;
  986.     char *checkpoint;
  987.     int sawcase = 0;
  988.  
  989.     toparse = Str_new(76,0);
  990.     str = Str_new(77,0);
  991.  
  992.     str_nset(str,"",0);
  993.     str_nset(toparse,"",0);
  994.     t = s;
  995.     while (s < send) {
  996.     if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) {
  997.         str_ncat(str, t, s - t);
  998.         ++s;
  999.         if (isALPHA(*s)) {
  1000.         str_ncat(str, "$c", 2);
  1001.         sawcase = (*s != 'E');
  1002.         }
  1003.         else {
  1004.         if (*nointrp) {        /* in a regular expression */
  1005.             if (*s == '@')    /* always strip \@ */ /*SUPPRESS 530*/
  1006.             ;
  1007.             else        /* don't strip \\, \[, \{ etc. */
  1008.             str_ncat(str,s-1,1);
  1009.         }
  1010.         str_ncat(str, "$b", 2);
  1011.         }
  1012.         str_ncat(str, s, 1);
  1013.         ++s;
  1014.         t = s;
  1015.     }
  1016.     else if (*s == '$' && s+1 < send && *nointrp && index(nointrp,s[1])) {
  1017.         str_ncat(str, t, s - t);
  1018.         str_ncat(str, "$b", 2);
  1019.         str_ncat(str, s, 2);
  1020.         s += 2;
  1021.         t = s;
  1022.     }
  1023.     else if ((*s == '@' || *s == '$') && s+1 < send) {
  1024.         str_ncat(str,t,s-t);
  1025.         t = s;
  1026.         if (*s == '$' && s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
  1027.         s++;
  1028.         s = scanident(s,send,tokenbuf);
  1029.         if (*t == '@' &&
  1030.           (!(stab = stabent(tokenbuf,FALSE)) || 
  1031.          (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
  1032.         str_ncat(str,"@",1);
  1033.         s = ++t;
  1034.         continue;    /* grandfather @ from old scripts */
  1035.         }
  1036.         str_ncat(str,"$a",2);
  1037.         str_ncat(toparse,",",1);
  1038.         if (t[1] != '{' && (*s == '['  || *s == '{' /* }} */ ) &&
  1039.           (stab = stabent(tokenbuf,FALSE)) &&
  1040.           ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
  1041.         brackets = 0;
  1042.         checkpoint = s;
  1043.         do {
  1044.             switch (*s) {
  1045.             case '[':
  1046.             brackets++;
  1047.             break;
  1048.             case '{':
  1049.             brackets++;
  1050.             break;
  1051.             case ']':
  1052.             brackets--;
  1053.             break;
  1054.             case '}':
  1055.             brackets--;
  1056.             break;
  1057.             case '$':
  1058.             case '%':
  1059.             case '@':
  1060.             case '&':
  1061.             case '*':
  1062.             s = scanident(s,send,tokenbuf);
  1063.             continue;
  1064.             case '\'':
  1065.             case '"':
  1066.             /*SUPPRESS 68*/
  1067.             s = cpytill(tokenbuf,s+1,send,*s,&len);
  1068.             if (s >= send)
  1069.                 fatal("Unterminated string");
  1070.             break;
  1071.             }
  1072.             s++;
  1073.         } while (brackets > 0 && s < send);
  1074.         if (s > send)
  1075.             fatal("Unmatched brackets in string");
  1076.         if (*nointrp) {        /* we're in a regular expression */
  1077.             d = checkpoint;
  1078.             if (*d == '{' && s[-1] == '}') {    /* maybe {n,m} */
  1079.             ++d;
  1080.             if (isDIGIT(*d)) {    /* matches /^{\d,?\d*}$/ */
  1081.                 if (*++d == ',')
  1082.                 ++d;
  1083.                 while (isDIGIT(*d))
  1084.                 d++;
  1085.                 if (d == s - 1)
  1086.                 s = checkpoint;        /* Is {n,m}! Backoff! */
  1087.             }
  1088.             }
  1089.             else if (*d == '[' && s[-1] == ']') { /* char class? */
  1090.             int weight = 2;        /* let's weigh the evidence */
  1091.             char seen[256];
  1092.             unsigned char un_char = 0, last_un_char;
  1093.  
  1094.             Zero(seen,256,char);
  1095.             *--s = '\0';
  1096.             if (d[1] == '^')
  1097.                 weight += 150;
  1098.             else if (d[1] == '$')
  1099.                 weight -= 3;
  1100.             if (isDIGIT(d[1])) {
  1101.                 if (d[2]) {
  1102.                 if (isDIGIT(d[2]) && !d[3])
  1103.                     weight -= 10;
  1104.                 }
  1105.                 else
  1106.                 weight -= 100;
  1107.             }
  1108.             for (d++; d < s; d++) {
  1109.                 last_un_char = un_char;
  1110.                 un_char = (unsigned char)*d;
  1111.                 switch (*d) {
  1112.                 case '&':
  1113.                 case '$':
  1114.                 weight -= seen[un_char] * 10;
  1115.                 if (isALNUM(d[1])) {
  1116.                     d = scanident(d,s,tokenbuf);
  1117.                     if (stabent(tokenbuf,FALSE))
  1118.                     weight -= 100;
  1119.                     else
  1120.                     weight -= 10;
  1121.                 }
  1122.                 else if (*d == '$' && d[1] &&
  1123.                   index("[#!%*<>()-=",d[1])) {
  1124.                     if (!d[2] || /*{*/ index("])} =",d[2]))
  1125.                     weight -= 10;
  1126.                     else
  1127.                     weight -= 1;
  1128.                 }
  1129.                 break;
  1130.                 case '\\':
  1131.                 un_char = 254;
  1132.                 if (d[1]) {
  1133.                     if (index("wds",d[1]))
  1134.                     weight += 100;
  1135.                     else if (seen['\''] || seen['"'])
  1136.                     weight += 1;
  1137.                     else if (index("rnftb",d[1]))
  1138.                     weight += 40;
  1139.                     else if (isDIGIT(d[1])) {
  1140.                     weight += 40;
  1141.                     while (d[1] && isDIGIT(d[1]))
  1142.                         d++;
  1143.                     }
  1144.                 }
  1145.                 else
  1146.                     weight += 100;
  1147.                 break;
  1148.                 case '-':
  1149.                 if (last_un_char < (unsigned char) d[1]
  1150.                   || d[1] == '\\') {
  1151.                     if (index("aA01! ",last_un_char))
  1152.                     weight += 30;
  1153.                     if (index("zZ79~",d[1]))
  1154.                     weight += 30;
  1155.                 }
  1156.                 else
  1157.                     weight -= 1;
  1158.                 default:
  1159.                 if (isALPHA(*d) && d[1] && isALPHA(d[1])) {
  1160.                     bufptr = d;
  1161.                     if (yylex() != WORD)
  1162.                     weight -= 150;
  1163.                     d = bufptr;
  1164.                 }
  1165.                 if (un_char == last_un_char + 1)
  1166.                     weight += 5;
  1167.                 weight -= seen[un_char];
  1168.                 break;
  1169.                 }
  1170.                 seen[un_char]++;
  1171.             }
  1172. #ifdef DEBUGGING
  1173. #ifdef macintosh
  1174.             if (debug & 512)
  1175.                 fprintf(perldbg,"[%s] weight %d\n",
  1176.                   checkpoint+1,weight);
  1177. #else
  1178.             if (debug & 512)
  1179.                 fprintf(stderr,"[%s] weight %d\n",
  1180.                   checkpoint+1,weight);
  1181. #endif
  1182. #endif
  1183.             *s++ = ']';
  1184.             if (weight >= 0)    /* probably a character class */
  1185.                 s = checkpoint;
  1186.             }
  1187.         }
  1188.         }
  1189.         if (*t == '@')
  1190.         str_ncat(toparse, "join($\",", 8);
  1191.         if (t[1] == '{' && s[-1] == '}') {
  1192.         str_ncat(toparse, t, 1);
  1193.         str_ncat(toparse, t+2, s - t - 3);
  1194.         }
  1195.         else
  1196.         str_ncat(toparse, t, s - t);
  1197.         if (*t == '@')
  1198.         str_ncat(toparse, ")", 1);
  1199.         t = s;
  1200.     }
  1201.     else
  1202.         s++;
  1203.     }
  1204.     str_ncat(str,t,s-t);
  1205.     if (sawcase)
  1206.     str_ncat(str, "$cE", 3);
  1207.     if (toparse->str_ptr && *toparse->str_ptr == ',') {
  1208.     *toparse->str_ptr = '(';
  1209.     str_ncat(toparse,",$$);",5);
  1210.     str->str_u.str_args = parselist(toparse);
  1211.     str->str_u.str_args->arg_len--;        /* ignore $$ reference */
  1212.     }
  1213.     else
  1214.     str->str_u.str_args = Nullarg;
  1215.     str_free(toparse);
  1216.     str->str_pok |= SP_INTRP;
  1217.     str->str_nok = 0;
  1218.     str_replace(src,str);
  1219. }
  1220.  
  1221. STR *
  1222. interp(str,src,sp)
  1223. register STR *str;
  1224. STR *src;
  1225. int sp;
  1226. {
  1227.     register char *s;
  1228.     register char *t;
  1229.     register char *send;
  1230.     register STR **elem;
  1231.     int docase = 0;
  1232.     int l = 0;
  1233.     int u = 0;
  1234.     int L = 0;
  1235.     int U = 0;
  1236.  
  1237.     if (str == &str_undef)
  1238.     return Nullstr;
  1239.     if (!(src->str_pok & SP_INTRP)) {
  1240.     int oldsave = savestack->ary_fill;
  1241.  
  1242. #ifndef macintosh
  1243.     (void)savehptr(&curstash);
  1244. #else
  1245.     savehptr(&curstash);
  1246. #endif
  1247.     curstash = curcmd->c_stash;    /* so stabent knows right package */
  1248.     intrpcompile(src);
  1249.     restorelist(oldsave);
  1250.     }
  1251.     s = src->str_ptr;        /* assumed valid since str_pok set */
  1252.     t = s;
  1253.     send = s + src->str_cur;
  1254.  
  1255.     if (src->str_u.str_args) {
  1256.     (void)eval(src->str_u.str_args,G_ARRAY,sp);
  1257.     /* Assuming we have correct # of args */
  1258.     elem = stack->ary_array + sp;
  1259.     }
  1260.  
  1261.     str_nset(str,"",0);
  1262.     while (s < send) {
  1263.     if (*s == '$' && s+1 < send) {
  1264.         if (s-t > 0)
  1265.         str_ncat(str,t,s-t);
  1266.         switch(*++s) {
  1267.         default:
  1268.         fatal("panic: unknown interp cookie\n");
  1269.         break;
  1270.         case 'a':
  1271.         str_scat(str,*++elem);
  1272.         break;
  1273.         case 'b':
  1274.         str_ncat(str,++s,1);
  1275.         break;
  1276.         case 'c':
  1277.         if (docase && str->str_cur >= docase) {
  1278.             char *b = str->str_ptr + --docase;
  1279.  
  1280.             if (L)
  1281.             lcase(b, str->str_ptr + str->str_cur);
  1282.             else if (U)
  1283.             ucase(b, str->str_ptr + str->str_cur);
  1284.  
  1285.             if (u)    /* note that l & u are independent of L & U */
  1286.             ucase(b, b+1);
  1287.             else if (l)
  1288.             lcase(b, b+1);
  1289.             l = u = 0;
  1290.         }
  1291.         docase = str->str_cur + 1;
  1292.         switch (*++s) {
  1293.         case 'u':
  1294.             u = 1;
  1295.             l = 0;
  1296.             break;
  1297.         case 'U':
  1298.             U = 1;
  1299.             L = 0;
  1300.             break;
  1301.         case 'l':
  1302.             l = 1;
  1303.             u = 0;
  1304.             break;
  1305.         case 'L':
  1306.             L = 1;
  1307.             U = 0;
  1308.             break;
  1309.         case 'E':
  1310.             docase = L = U = l = u = 0;
  1311.             break;
  1312.         }
  1313.         break;
  1314.         }
  1315.         t = ++s;
  1316.     }
  1317.     else
  1318.         s++;
  1319.     }
  1320.     if (s-t > 0)
  1321.     str_ncat(str,t,s-t);
  1322.     return str;
  1323. }
  1324.  
  1325. static void
  1326. ucase(s,send)
  1327. register char *s;
  1328. register char *send;
  1329. {
  1330.     while (s < send) {
  1331.     if (isLOWER(*s))
  1332.         *s = toupper(*s);
  1333.     s++;
  1334.     }
  1335. }
  1336.  
  1337. static void
  1338. lcase(s,send)
  1339. register char *s;
  1340. register char *send;
  1341. {
  1342.     while (s < send) {
  1343.     if (isUPPER(*s))
  1344.         *s = tolower(*s);
  1345.     s++;
  1346.     }
  1347. }
  1348.  
  1349. void
  1350. str_inc(str)
  1351. register STR *str;
  1352. {
  1353.     register char *d;
  1354.  
  1355.     if (!str || str == &str_undef)
  1356.     return;
  1357.     if (str->str_nok) {
  1358.     str->str_u.str_nval += 1.0;
  1359.     str->str_pok = 0;
  1360.     return;
  1361.     }
  1362.     if (!str->str_pok || !*str->str_ptr) {
  1363.     str->str_u.str_nval = 1.0;
  1364.     str->str_nok = 1;
  1365.     str->str_pok = 0;
  1366.     return;
  1367.     }
  1368.     d = str->str_ptr;
  1369.     while (isALPHA(*d)) d++;
  1370.     while (isDIGIT(*d)) d++;
  1371.     if (*d) {
  1372.         str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
  1373.     return;
  1374.     }
  1375.     d--;
  1376.     while (d >= str->str_ptr) {
  1377.     if (isDIGIT(*d)) {
  1378.         if (++*d <= '9')
  1379.         return;
  1380.         *(d--) = '0';
  1381.     }
  1382.     else {
  1383.         ++*d;
  1384.         if (isALPHA(*d))
  1385.         return;
  1386.         *(d--) -= 'z' - 'a' + 1;
  1387.     }
  1388.     }
  1389.     /* oh,oh, the number grew */
  1390.     STR_GROW(str, str->str_cur + 2);
  1391.     str->str_cur++;
  1392.     for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
  1393.     *d = d[-1];
  1394.     if (isDIGIT(d[1]))
  1395.     *d = '1';
  1396.     else
  1397.     *d = d[1];
  1398. }
  1399.  
  1400. void
  1401. str_dec(str)
  1402. register STR *str;
  1403. {
  1404.     if (!str || str == &str_undef)
  1405.     return;
  1406.     if (str->str_nok) {
  1407.     str->str_u.str_nval -= 1.0;
  1408.     str->str_pok = 0;
  1409.     return;
  1410.     }
  1411.     if (!str->str_pok) {
  1412.     str->str_u.str_nval = -1.0;
  1413.     str->str_nok = 1;
  1414.     return;
  1415.     }
  1416.     str_numset(str,atof(str->str_ptr) - 1.0);
  1417. }
  1418.  
  1419. /* Make a string that will exist for the duration of the expression
  1420.  * evaluation.  Actually, it may have to last longer than that, but
  1421.  * hopefully cmd_exec won't free it until it has been assigned to a
  1422.  * permanent location. */
  1423.  
  1424. static long tmps_size = -1;
  1425.  
  1426. STR *
  1427. str_mortal(oldstr)
  1428. STR *oldstr;
  1429. {
  1430.     register STR *str = Str_new(78,0);
  1431.  
  1432.     str_sset(str,oldstr);
  1433.     if (++tmps_max > tmps_size) {
  1434.     tmps_size = tmps_max;
  1435.     if (!(tmps_size & 127)) {
  1436.         if (tmps_size)
  1437.         Renew(tmps_list, tmps_size + 128, STR*);
  1438.         else
  1439.         New(702,tmps_list, 128, STR*);
  1440.     }
  1441.     }
  1442.     tmps_list[tmps_max] = str;
  1443.     if (str->str_pok)
  1444.     str->str_pok |= SP_TEMP;
  1445.     return str;
  1446. }
  1447.  
  1448. /* same thing without the copying */
  1449.  
  1450. STR *
  1451. str_2mortal(str)
  1452. register STR *str;
  1453. {
  1454.     if (!str || str == &str_undef)
  1455.     return str;
  1456.     if (++tmps_max > tmps_size) {
  1457.     tmps_size = tmps_max;
  1458.     if (!(tmps_size & 127)) {
  1459.         if (tmps_size)
  1460.         Renew(tmps_list, tmps_size + 128, STR*);
  1461.         else
  1462.         New(704,tmps_list, 128, STR*);
  1463.     }
  1464.     }
  1465.     tmps_list[tmps_max] = str;
  1466.     if (str->str_pok)
  1467.     str->str_pok |= SP_TEMP;
  1468.     return str;
  1469. }
  1470.  
  1471. STR *
  1472. str_make(s,len)
  1473. char *s;
  1474. STRLEN len;
  1475. {
  1476.     register STR *str = Str_new(79,0);
  1477.  
  1478.     if (!len)
  1479.     len = strlen(s);
  1480.     str_nset(str,s,len);
  1481.     return str;
  1482. }
  1483.  
  1484. STR *
  1485. str_nmake(n)
  1486. double n;
  1487. {
  1488.     register STR *str = Str_new(80,0);
  1489.  
  1490.     str_numset(str,n);
  1491.     return str;
  1492. }
  1493.  
  1494. /* make an exact duplicate of old */
  1495.  
  1496. STR *
  1497. str_smake(old)
  1498. register STR *old;
  1499. {
  1500.     register STR *new = Str_new(81,0);
  1501.  
  1502.     if (!old)
  1503.     return Nullstr;
  1504.     if (old->str_state == SS_FREE) {
  1505.     warn("semi-panic: attempt to dup freed string");
  1506.     return Nullstr;
  1507.     }
  1508.     if (old->str_state == SS_INCR && !(old->str_pok & 2))
  1509.     Str_Grow(old,0);
  1510.     if (new->str_ptr)
  1511.     Safefree(new->str_ptr);
  1512.     StructCopy(old,new,STR);
  1513.     if (old->str_ptr) {
  1514.     new->str_ptr = nsavestr(old->str_ptr,old->str_len);
  1515.     new->str_pok &= ~SP_TEMP;
  1516.     }
  1517.     return new;
  1518. }
  1519.  
  1520. void
  1521. str_reset(s,stash)
  1522. register char *s;
  1523. HASH *stash;
  1524. {
  1525.     register HENT *entry;
  1526.     register STAB *stab;
  1527.     register STR *str;
  1528.     register int i;
  1529.     register SPAT *spat;
  1530.     register int max;
  1531.  
  1532.     if (!*s) {        /* reset ?? searches */
  1533.     for (spat = stash->tbl_spatroot;
  1534.       spat != Nullspat;
  1535.       spat = spat->spat_next) {
  1536.         spat->spat_flags &= ~SPAT_USED;
  1537.     }
  1538.     return;
  1539.     }
  1540.  
  1541.     /* reset variables */
  1542.  
  1543.     if (!stash->tbl_array)
  1544.     return;
  1545.     while (*s) {
  1546.     i = *s;
  1547.     if (s[1] == '-') {
  1548.         s += 2;
  1549.     }
  1550.     max = *s++;
  1551.     for ( ; i <= max; i++) {
  1552.         for (entry = stash->tbl_array[i];
  1553.           entry;
  1554.           entry = entry->hent_next) {
  1555.         stab = (STAB*)entry->hent_val;
  1556.         str = stab_val(stab);
  1557.         str->str_cur = 0;
  1558.         str->str_nok = 0;
  1559. #ifdef TAINT
  1560.         str->str_tainted = tainted;
  1561. #endif
  1562.         if (str->str_ptr != Nullch)
  1563.             str->str_ptr[0] = '\0';
  1564.         if (stab_xarray(stab)) {
  1565.             aclear(stab_xarray(stab));
  1566.         }
  1567.         if (stab_xhash(stab)) {
  1568.             hclear(stab_xhash(stab), FALSE);
  1569.             if (stab == envstab)
  1570.             environ[0] = Nullch;
  1571.         }
  1572.         }
  1573.     }
  1574.     }
  1575. }
  1576.  
  1577. #ifdef TAINT
  1578. void
  1579. taintproper(s)
  1580. char *s;
  1581. {
  1582. #ifdef DEBUGGING
  1583. #ifdef macintosh
  1584.     if (debug & 2048)
  1585.     fprintf(perldbg,"%s %d %d %d\n",s,tainted,uid, euid);
  1586. #else
  1587.     if (debug & 2048)
  1588.     fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
  1589. #endif
  1590. #endif
  1591.     if (tainted && (!euid || euid != uid || egid != gid || taintanyway)) {
  1592.     if (!unsafe)
  1593.         fatal("%s", s);
  1594.     else if (dowarn)
  1595.         warn("%s", s);
  1596.     }
  1597. }
  1598.  
  1599. void
  1600. taintenv()
  1601. {
  1602.     register STR *envstr;
  1603.  
  1604.     envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
  1605.     if (envstr == &str_undef || envstr->str_tainted) {
  1606.     tainted = 1;
  1607.     if (envstr->str_tainted == 2)
  1608.         taintproper("Insecure directory in PATH");
  1609.     else
  1610.         taintproper("Insecure PATH");
  1611.     }
  1612.     envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
  1613.     if (envstr != &str_undef && envstr->str_tainted) {
  1614.     tainted = 1;
  1615.     taintproper("Insecure IFS");
  1616.     }
  1617. }
  1618. #endif /* TAINT */
  1619.  
  1620. void init_str()
  1621. {
  1622.     tmps_size = -1;
  1623. }
  1624.